How to Create an Interactive WebGL Network Graph Using R

This R Notebook is the complement to my blog post What Percent of the Top-Voted Comments in Reddit Threads Were Also 1st Comment?.

This notebook is licensed under the MIT License. If you use the code or data visualization designs contained within this notebook, it would be greatly appreciated if proper attribution is given back to this notebook and/or myself. Thanks! :)

1 Setup

Setup the R packages.

library(dplyr)
library(nycflights13)
library(igraph)
library(intergraph)
library(sna)
library(ggplot2)
library(ggnetwork)
library(viridis)
library(plotly)
library(htmlwidgets)

The nycflights13 package contains a flights dataset.

flights %>% head()

There are 336,776 flights in the dataset.

2 Build the Network

Getting the edge weights is a dplyr aggregation.

df_edges <- flights %>% group_by(origin, dest) %>% summarize(weight = n())
df_edges %>% arrange(desc(weight)) %>% head()

There are 224 total edges.

Add a colors column to edge for each origin which will eventually be used for final ggplot.

# blue, red, green
colors = c("#3498db", "#e74c3c", "#2ecc71")
# seting alphabetical order; allows for predictable ordering later
origins = c("EWR", "JFK", "LGA")
df_colors = tbl_df(data.frame(origin=origins, color=origins))
df_edges <- df_edges %>% left_join(df_colors)

Joining, by = "origin"
joining factor and character vector, coercing into character vector

df_edges %>% arrange(desc(weight)) %>% head()

net <- graph.data.frame(df_edges, directed = T)
V(net)$degree <- centralization.degree(net)$res
V(net)$weighted_degree <- graph.strength(net)
V(net)$color_v <- c(origins, rep("Others", gorder(net) - length(colors)))
net

IGRAPH DNW- 107 224 -- 
+ attr: name (v/c), degree (v/n), weighted_degree (v/n), color_v
| (v/c), weight (e/n), color (e/c)
+ edges (vertex names):
 [1] EWR->ALB EWR->ANC EWR->ATL EWR->AUS EWR->AVL EWR->BDL EWR->BNA EWR->BOS
 [9] EWR->BQN EWR->BTV EWR->BUF EWR->BWI EWR->BZN EWR->CAE EWR->CHS EWR->CLE
[17] EWR->CLT EWR->CMH EWR->CVG EWR->DAY EWR->DCA EWR->DEN EWR->DFW EWR->DSM
[25] EWR->DTW EWR->EGE EWR->FLL EWR->GRR EWR->GSO EWR->GSP EWR->HDN EWR->HNL
[33] EWR->HOU EWR->IAD EWR->IAH EWR->IND EWR->JAC EWR->JAX EWR->LAS EWR->LAX
[41] EWR->LGA EWR->MCI EWR->MCO EWR->MDW EWR->MEM EWR->MHT EWR->MIA EWR->MKE
[49] EWR->MSN EWR->MSP EWR->MSY EWR->MTJ EWR->MYR EWR->OKC EWR->OMA EWR->ORD
+ ... omitted several edges

Write specialized hovertext for each vertex. Note that airport attributes must be mapped to same order as vertices.

df_airports <- data.frame(vname=V(net)$name) %>% left_join(airports, by=c("vname" = "faa"))

joining character vector and factor, coercing into character vector

V(net)$text <- paste(V(net)$name,
                       df_airports$name,
                       paste(format(V(net)$weighted_degree, big.mark=",", trim=T), "Flights"),
                        sep = "<br>")
V(net)$text %>% head()

[1] "EWR<br>Newark Liberty Intl<br>120,835 Flights"           
[2] "JFK<br>John F Kennedy Intl<br>111,279 Flights"           
[3] "LGA<br>La Guardia<br>104,663 Flights"                    
[4] "ALB<br>Albany Intl<br>439 Flights"                       
[5] "ANC<br>Ted Stevens Anchorage Intl<br>8 Flights"          
[6] "ATL<br>Hartsfield Jackson Atlanta Intl<br>17,215 Flights"

Add latitudes/longitudes to both vertices and edges for spatial map;

V(net)$lat <- df_airports$lat
V(net)$lon <- df_airports$lon
# gives to/from locations; map to corresponding ending lat/long
end_loc <- data.frame(ename=get.edgelist(net)[,2]) %>% left_join(airports, by=c("ename" = "faa"))

joining character vector and factor, coercing into character vector

E(net)$endlat <- end_loc$lat
E(net)$endlon <- end_loc$lon

3 Plotting the Network Graph

Use ggnetwork to transform the network to a ggplot friendly format.

df_net <- ggnetwork(net, layout = "fruchtermanreingold", weights="weight", niter=5000, arrow.gap=0)
df_net %>% head()

plot <- ggplot(df_net, aes(x = x, y = y, xend = xend, yend = yend)) +
    geom_edges(aes(color = color), size=0.4, alpha=0.25) +
    geom_nodes(aes(color = color_v, size = degree, text=text)) +
    ggtitle("Network Graph of U.S. Flights Outbound from NYC in 2013") +
    scale_color_manual(labels=c("LGA", "EWR", "JFK", "Others"), 
                         values=c(colors, "#1a1a1a"), name="Airports") +
    guides(size=FALSE) +
    theme_blank()
plot

plot %>% ggplotly(tooltip="text") %>% toWebGL()

Save interactive plot locally to disk using htmlwidgets for uploading to my website. (this only saves the data/layout; you will need to provide the relevant plot.ly javascript on your own website)

plot %>% ggplotly(tooltip="text", width="100%", height=600) %>%
    saveWidget("ggplot-graph-1.html", selfcontained=F, libdir="plotly")

3.1 Plot by Physical Location

plot <- ggplot(df_net, aes(x = lon, y = lat, xend = endlon, yend = endlat)) +
    geom_edges(aes(color = color), size=0.4, alpha=0.25) +
    geom_nodes(aes(color = color_v, size = degree, text=text)) +
    ggtitle("Locations of U.S. Flights Outbound from NYC in 2013") +
    scale_color_manual(labels=c("LGA", "EWR", "JFK", "Others"), 
                         values=c(colors, "#1a1a1a"), name="Airports") +
    guides(size=FALSE) +
    theme_blank()
plot

plot %>% ggplotly(tooltip="text") %>% toWebGL()

plot %>% ggplotly(tooltip="text", width="100%", height=600) %>%
    saveWidget("ggplot-graph-2.html", selfcontained=F, libdir="plotly")

4 LICENSE

The MIT License (MIT)

Copyright (c) 2016 Max Woolf

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.